perm filename PRED.FIX[1,JRA] blob sn#036229 filedate 1973-04-18 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP <PREDIC> 
00400	 (LAMBDA NIL
00500	  (NLRR (QUOTE PREDIC)
00600		(FUNCTION
00700		 (LAMBDA NIL
00800		  (COND ((AND (SPWD ANCESTRY)) (QUOTE ANCESTRY))
00900			((AND (SPWD NONE)) (QUOTE NONE))
01000			((AND (SPWD VINE)) (QUOTE VINE))
01100			((AND (SPWD UNIT)) (QUOTE UNIT))
01200			((AND (SPWD P1)) (QUOTE ALLPOS))
01300			((AND (SPWD P2)) (QUOTE ALLNEG))
01400			((AND (SPWD SUPPORT) (CH /[) (<C>) (CH /])) (CONS (QUOTE SUPPORT) (STK 1)))
01500			((AND (SPWD DEPTH) (CH /[) (<NUMBER>) (CH /]))
01600			 (CONS (QUOTE MAXDEPTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) (CONS (STK 1) NIL))))
01700			((AND (SPWD SELDEPTH) (CH /[) (<FNLSTP>) (CH /])) (CONS (QUOTE DEP) (STK 1)))
01800			((AND (SPWD LENGTH) (CH /[) (<NUMBER>) (CH /]))
01900			 (CONS (QUOTE MAXLENGTH) (CONS (QUOTE C) (CONS (STK 1) NIL))))
02000			((AND (SPWD MODEL) (CH /[) (<PREDLST>) (CH ;) (<PREDLST1>) (CH /]))
02100			 (CONS (QUOTE MODEL) (CONS (STK 3) (CONS (STK 1) NIL))))
02200			((AND (SPWD EQUALITY) (CH /[) (<OP>) (CH /;) (<NUMBER>) (CH /]))
02300			 (CONS (QUOTE EQUALITY) (CONS (STK 3) (CONS (STK 1) NIL))))
02400			((AND (SPWD DEMOD) (CH /[) (<CLAUSES>) (<NUMBER>) (CH /]))
02500			 (CONS (QUOTE DEMOD) (CONS (STK 2) (CONS (STK 1) NIL))))
02600			((AND (SPWD DEFMODEL) (CH /[) (SPWD ID) (CH /])) (CONS (QUOTE DEFMODEL) (QUOTE ID)))
02700			((AND (<MPRM>)) (STK 0))
02800			(*NIL*)))))) 
02900	EXPR)
03000	
03100	(DEFPROP >PREDIC< 
03200	 (LAMBDA(%N)
03300	  (OUTRUL %N
03400		  (FUNCTION
03500		   (LAMBDA NIL
03600		    (COND ((EQ (QUOTE ANCESTRY) (STK1)) (QUOTE ANCESTRY))
03700			  ((EQ (QUOTE NONE) (STK1)) (QUOTE NONE))
03800			  ((EQ (QUOTE VINE) (STK1)) (QUOTE VINE))
03900			  ((EQ (QUOTE UNIT) (STK1)) (QUOTE UNIT))
04000			  ((EQ (QUOTE ALLPOS) (STK1)) (QUOTE P1))
04100			  ((EQ (QUOTE ALLNEG) (STK1)) (QUOTE P2))
04200			  ((AND (MATCH (QUOTE (SUPPORT . *))) (>C< 0))
04300			   (LIST (QUOTE SUPPORT) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
04400			  ((AND (MATCH (QUOTE (MAXDEPTH (CDR C) *))) (>NUMBER< 0))
04500			   (LIST (QUOTE DEPTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
04600			  ((AND (MATCH (QUOTE (DEP . *))) (>FNLSTP< 0))
04700			   (LIST (QUOTE SELDEPTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
04800			  ((AND (MATCH (QUOTE (MAXLENGTH C *))) (>NUMBER< 0))
04900			   (LIST (QUOTE LENGTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
05000			  ((AND (MATCH (QUOTE (MODEL * *))) (>PREDLST< 1) (>PREDLST1< 0))
05100			   (LIST (QUOTE MODEL) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH ;)) (STK0) (QUOTE (:CH /]))))
05200			  ((AND (MATCH (QUOTE (EQUALITY * *))) (>OP< 1) (>NUMBER< 0))
05300			   (LIST (QUOTE EQUALITY) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /;)) (STK0) (QUOTE (:CH /]))))
05400			  ((AND (MATCH (QUOTE (DEMOD * *))) (>CLAUSES< 1) (>NUMBER< 0))
05500			   (LIST (QUOTE DEMOD) (QUOTE (:CH /[)) (STK1) (STK0) (QUOTE (:CH /]))))
05600			  ((AND (MATCH (QUOTE (DEFMODEL . ID))))
05700			   (LIST (QUOTE DEFMODEL) (QUOTE (:CH /[)) (QUOTE ID) (QUOTE (:CH /]))))
05800			  ((>MPRM< 1) (STK1))))))) 
05900	EXPR)
06000	
06100	(DEFPROP <PREDLST> 
06200	 (LAMBDA NIL
06300	  (NLRR (QUOTE PREDLST)
06400		(FUNCTION
06500		 (LAMBDA NIL
06600		  (COND ((AND (<PREDLET>) (CH /,) (<PREDLST>)) (CONS (STK 2) (STK 0)))
06700			((AND (<PREDLET>)) (STK 0))
06800			((AND) NIL)
06900			(*NIL*)))))) 
07000	EXPR)
07100	
07200	(DEFPROP >PREDLST< 
07300	 (LAMBDA(%N)
07400	  (OUTRUL %N
07500		  (FUNCTION
07600		   (LAMBDA NIL
07700		    (COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
07800			  ((AND (MATCH (QUOTE (* . *))) (>PREDLET< 1) (>PREDLST< 0)) (LIST (STK1) (QUOTE (:CH /,)) (STK0)))
07900			  ((>PREDLET< 1) (STK1))))))) 
08000	EXPR)